R Notebook

In this project I analyze traffic data from Bloomington in the USA. I focused on Data visualisation, feature engeneering and trying to give advice for the city in order to improve the traffic situation.

I goot the traffic data from data.gov

library(rio)

Paket 㤼㸱rio㤼㸲 wurde unter R Version 4.0.2 erstelltThe following rio suggested packages are not installed: 㤼㸱csvy㤼㸲, 㤼㸱feather㤼㸲, 㤼㸱fst㤼㸲, 㤼㸱hexView㤼㸲, 㤼㸱readODS㤼㸲, 㤼㸱rmatio㤼㸲
Use 'install_formats()' to install them

library(tidyverse)

Paket 㤼㸱tidyverse㤼㸲 wurde unter R Version 4.0.2 erstelltRegistered S3 methods overwritten by 'dbplyr':
  method         from
  print.tbl_lazy     
  print.tbl_sql      
-- Attaching packages --------------------------------------- tidyverse 1.3.0 --
v tibble  3.0.3     v dplyr   1.0.2
v tidyr   1.1.2     v stringr 1.4.0
v readr   1.3.1     v forcats 0.5.0
v purrr   0.3.4     
Paket 㤼㸱tibble㤼㸲 wurde unter R Version 4.0.2 erstelltPaket 㤼㸱tidyr㤼㸲 wurde unter R Version 4.0.2 erstelltPaket 㤼㸱readr㤼㸲 wurde unter R Version 4.0.2 erstelltPaket 㤼㸱purrr㤼㸲 wurde unter R Version 4.0.2 erstelltPaket 㤼㸱dplyr㤼㸲 wurde unter R Version 4.0.2 erstelltPaket 㤼㸱stringr㤼㸲 wurde unter R Version 4.0.2 erstelltPaket 㤼㸱forcats㤼㸲 wurde unter R Version 4.0.2 erstellt-- Conflicts ------------------------------------------ tidyverse_conflicts() --
x dplyr::filter() masks stats::filter()
x dplyr::lag()    masks stats::lag()
x purrr::lift()   masks caret::lift()

library(caret)

#read data
traffic <- import("Traffic_dataset.csv")
traffic <- as_tibble(traffic)
traffic

options(dplyr.width = Inf)

#change column names
traffic <- traffic %>% 
  select(Id = `Master Record Number`, Year, Month, Day, Weekend = `Weekend?`, Hour, Collision_Type = `Collision Type`,
         Injury_Type = `Injury Type`, Primary_Factor = `Primary Factor`, Location = Reported_Location, Latitude, Longitude)

Data Description:

Id = Id, primary Key Year = year of accident Month = Month of accident day = day of accident weekend = weekend or not Hour = Hour of accident Collision_Type = Type of collision Injury Type = Type of injury primary_Factor = What was the reason that let the accident happen Location = Where did it happen? Latitude Longutude

#Hour, Latitude and Logitude have NA Columns

#Na check
sapply(traffic, function(x) sum(is.na(x)))

            Id           Year          Month            Day        Weekend           Hour Collision_Type    Injury_Type 
             0              0              0              0              0            225              0              0 
Primary_Factor       Location       Latitude      Longitude 
             0              0             30             30 

#Feature Engineering

#Variable check
traffic %>% 
  glimpse()

Rows: 53,943
Columns: 12
$ Id             <int> 902363382, 902364268, 902364412, 902364551, 902364615, 902364664, 902364682, 902364683, 9023647...
$ Year           <int> 2015, 2015, 2015, 2015, 2015, 2015, 2015, 2015, 2015, 2015, 2015, 2015, 2015, 2015, 2015, 2015,...
$ Month          <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,...
$ Day            <int> 5, 6, 6, 7, 7, 6, 6, 6, 7, 7, 7, 7, 7, 7, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 2, 2, 2, 1, 2, 1, 2, 2,...
$ Weekend        <chr> "Weekday", "Weekday", "Weekend", "Weekend", "Weekend", "Weekday", "Weekday", "Weekday", "Weeken...
$ Hour           <int> 0, 1500, 2300, 900, 1100, 1800, 1200, 1400, 1400, 1600, 1500, 1600, 1700, 1800, 1300, 1500, 180...
$ Collision_Type <chr> "2-Car", "2-Car", "2-Car", "2-Car", "2-Car", "2-Car", "2-Car", "1-Car", "2-Car", "1-Car", "2-Ca...
$ Injury_Type    <chr> "No injury/unknown", "No injury/unknown", "Non-incapacitating", "Non-incapacitating", "No injur...
$ Primary_Factor <chr> "OTHER (DRIVER) - EXPLAIN IN NARRATIVE", "FOLLOWING TOO CLOSELY", "DISREGARD SIGNAL/REG SIGN", ...
$ Location       <chr> "1ST & FESS", "2ND & COLLEGE", "BASSWOOD & BLOOMFIELD", "GATES & JACOBS", "W 3RD", "BURKS & WAL...
$ Latitude       <dbl> 39.15921, 39.16144, 39.14978, 39.16566, 39.16485, 39.12667, 39.15082, 39.19927, 39.16461, 39.16...
$ Longitude      <dbl> -86.52587, -86.53485, -86.56889, -86.57596, -86.57962, -86.53137, -86.58490, -86.63702, -86.579...

I will change some variables to better data types

#changing Hour variable into a factor 
traffic$Hour <- as.factor(traffic$Hour)
traffic

#changing Id into factor
traffic$Id <- as.factor(traffic$Id)
#changing year,month, day into factor
traffic$Month <- as.factor(traffic$Month)
traffic$Day <- as.factor(traffic$Day)
traffic$Year <- as.factor(traffic$Year)

#Visualization

#In which year are most of the accidents?
ggplot(traffic, aes(Year)) + # all years are equivalent 
  geom_bar()

#In which month?
ggplot(traffic, aes(Month, fill = Year)) + #overall in month 10 (people have stiill summer wheels and forgot to change them) the most and in month 6 the least
  geom_bar() +
  facet_grid("Year")  #Differences between years

#In which Hour are the most accidents?
ggplot(traffic, aes(Hour)) +
  geom_bar()+ 
  coord_cartesian(c(0,24))#18:00 are the most accidents --> people are coming from work to home

#In which day? 
ggplot(traffic, aes(Day)) +
  geom_bar(aes(fill = Year), color = "black") #Overall the most accidents have been on Saturday (surprisingly)

#Check the Weekend
q <- ifelse(traffic$Day == 1 & traffic$Weekend == "Weekend", T, F)
traffic[-q,] #Surprisingly 1 did not mean "Monday" because their are "Weekdays" and "Weekends" with the factor 1. I would concloud that the Data is a bit Messi. So I will fix it.

#Because the "Weekend" Information is in "Day" (Day 6 & 7 are always Weekends) I can delete that column from the Dataset
traffic <- traffic %>% 
  select(-Weekend)

#Fixing the NA´s

sapply(traffic, function(x) sum(is.na(x)))

            Id           Year          Month            Day           Hour Collision_Type    Injury_Type Primary_Factor 
             0              0              0              0            225              0              0              0 
      Location       Latitude      Longitude 
             0             30             30 

#NA-Hour

traffic %>% 
  filter(is.na(Hour))

ggplot(traffic, aes(Collision_Type)) +  #Analyzing with Collision Type
         geom_bar(aes(fill = Hour), color = "black") #No pattern exist

ggplot(traffic, aes(Location)) +  #Analyzing with Location
  geom_bar(aes(fill = Hour), color = "black") #Too many 

#Filtering all Location that have more than 150 accidents 
traffic %>% 
  group_by(Location) %>% 
  count(Location) %>% 
  filter(n >= 150)

#Visualizing
a <- traffic %>% 
  filter(Location == "3RD ST"| Location == "E 10TH ST"| Location == "E 3RD ST"| Location == "S WALNUT ST"| 
           Location == "SR37N & VERNAL"| Location == "W 3RD ST") #filtering the most frequent variables
ggplot(a, aes(Location, fill = Hour)) +
  geom_bar(color = "black")

#replacing HOur
traffic$Hour <- ifelse(traffic$Location == "3RD ST" & is.na(traffic$Hour), 1500,traffic$Hour)
#Their are just 225 NA in Hour. Compared to 53000 rows, that isnt a large amount.  So there is no need to Analyze each type of accident in detail. Therefore we will take the most common accident-Time, which is 18:00. 
traffic %>% 
  group_by(Hour) %>% 
  count() %>% 
  filter(n > 3000)

traffic <- traffic %>% 
  replace_na(list(Hour = 1700))

After we fixed the “Hour” column, we will focuse on the latitude and longitude #Latitude

#Longitude (Bloomingtons Longitude is -88 (searched in google)

#NA´s in longitude 
traffic %>% 
  filter(is.na(Longitude)) %>% 
  select(Location) %>% 
  print(n = 100)

#BLOOMFIELD & LIBERTY
traffic %>% 
  filter(Location == "BLOOMFIELD & LIBERTY") %>% 
  select(Longitude, Latitude) #The Longitude is 0. That would mean, that this place in Bloomington is in Great Britain. Its obvious, that it cant be right, so i will change the Longitude to the real one found in the internet.

traffic[traffic$Location == "BLOOMFIELD & LIBERTY", "Longitude"] <- -88

#building function
Longi <- function(x) {
  traffic %>% 
    filter(Location == x) %>% 
    select(Longitude)
}
Longi("BLOOMFIELD & LIBERTY") #works nicely

#DODDS & ROGERS 
Longi("DODDS & ROGERS")

traffic[traffic$Location == "DODDS & ROGERS", "Longitude"] <- -86.5

#HARMONY
Longi("HARMONY")

traffic[traffic$Location == "HARMONY", "Longitude"] <- -88

#ALLEN & PATTERSON
Longi("ALLEN & PATTERSON")

traffic[traffic$Location == "ALLEN & PATTERSON", "Longitude"] <- -86.5

#2ND & LINCOLN
Longi("2ND & LINCOLN")

traffic[traffic$Location == "2ND & LINCOLN", "Longitude"] <- -86.5

#FORREST PARK & SR46W
Longi("FORREST PARK & SR46W")

traffic[traffic$Location == "FORREST PARK & SR46W", "Longitude"] <- -86.6

#RHORER & SARE
Longi("RHORER & SARE")

traffic[traffic$Location == "RHORER & SARE", "Longitude"] <- -86.5

#CLUBHOUSE & KINSER
Longi("CLUBHOUSE & KINSER")

traffic[traffic$Location == "CLUBHOUSE & KINSER", "Longitude"] <- -88

#SMITH
Longi("SMITH")

traffic[traffic$Location == "SMITH", "Longitude"] <- -88

#WALNUT & WINSLOW
Longi("WALNUT & WINSLOW")

traffic[traffic$Location == "WALNUT & WINSLOW", "Longitude"] <- -86.5

#BLOOMFIELD & PATTERSON
Longi("BLOOMFIELD & PATTERSON")

traffic[traffic$Location == "BLOOMFIELD & PATTERSON", "Longitude"] <- -88

#2ND & COLLEGE MALL
Longi("2ND & COLLEGE MALL")

traffic[traffic$Location == "2ND & COLLEGE MALL", "Longitude"] <- -86.5

#17TH & LISMORE
Longi("17TH & LISMORE")

traffic[traffic$Location == "17TH & LISMORE", "Longitude"] <- -88

#CORY & THIRD
Longi("CORY & THIRD")

traffic[traffic$Location == "CORY & THIRD", "Longitude"] <- -86.6

#3RD & BALLANTINE
Longi("3RD & BALLANTINE")

traffic[traffic$Location == "3RD & BALLANTINE", "Longitude"] <- -86.5

#3RD & HAWTHORNE
Longi("3RD & HAWTHORNE")

traffic[traffic$Location == "3RD & HAWTHORN", "Longitude"] <- -86.5

#PETE ELLIS
Longi("PETE ELLIS")

traffic[traffic$Location == "PETE ELLIS", "Longitude"] <- -86.5

#3RD & HAWTHORNE
Longi("3RD & HAWTHORNE")

traffic[traffic$Location == "3RD & HAWTHORNE", "Longitude"] <- -86.5

#VERMILYA & WALNUT
Longi("3RD & LIBERTY")

traffic[traffic$Location == "3RD & LIBERTY", "Longitude"] <- -86.6
Longi("3RD & LIBERTY")

traffic[traffic$Location == "3RD & LIBERTY", "Longitude"] <- -86.6
Longi("ALLEN & TIMOTHY")

traffic[traffic$Location == "ALLEN & TIMOTHY", "Longitude"] <- -86.6

#All others have Longitude 86.5
Longi("FAIRFAX & MCCORMICK")

Longi("CANADA & SARE")

Longi("LEONARD SPRINGS & SR45W")

Longi("VERMILYA & WALNUT")

Longi("BLUE SKY & FORREST PARK")

Longi("SOUTHERN & WALNUT")

Longi("3RD & SWAIN")

Longi("DODDS & MADISON")

Longi("OLD STATE ROAD 37 SOUTH & WEST CHUMLEY")

traffic <- traffic %>% 
  replace_na(list(Longitude = 86.5))

#final NA check
sapply(traffic, function(x) sum(is.na(x)))

            Id           Year          Month            Day           Hour Collision_Type    Injury_Type Primary_Factor 
             0              0              0              0              0              0              0              0 
      Location       Latitude      Longitude 
             0              0              0 

#NA Filling done :D
#0 Wert in Longitude und Location fixen
traffic[traffic$Longitude == 0, "Longitude"] <- -86.5

Now we finished the data cleaning/engeneering part and did some data exploration. Suruly we give advice to fix traffic in general. But we can fokus on the worst cases and see what we can do there. #Which Location has the most dangerous route/ the badest Injury_Type

#Which injury typ exsist?
ggplot(traffic, aes(x = Injury_Type)) +
  geom_bar()

#"Incapacitatig" and "fatal" are interesting for us, because we want to make driving car in Bloomington safer. Therefore we need to know the most unsafe locations
trafficBad <- traffic %>% 
  filter(Injury_Type == "Incapacitating" | Injury_Type ==  "Fatal")

trafficBad %>% 
  group_by(Location) %>% 
  summarise() %>% 
  print(n = Inf)

`summarise()` ungrouping output (override with `.groups` argument)

#as we can see, we have one Location that is empty "". We have to fix that.

#Filling an empty "" value

trafficBad %>% 
  filter(Location == "") 

trafficBad %>% 
  group_by(Location) %>% 
  summarise(count = n()) %>% 
  summarise(total_number_of_Locations = sum(count))

`summarise()` ungrouping output (override with `.groups` argument)

#since we have 1204 different Location we could try to build a multi label classifier. However, there is just one missig value in one row. Therefor its simply better to analyze the most common Locations with the Latidue and Longitude
trafficBad %>% 
  group_by(Location) %>% 
  summarise(count = n()) %>% 
  arrange(desc(count))        #The most common Location has only a frequency of 8 

`summarise()` ungrouping output (override with `.groups` argument)

Because of the low frequency we will do a chi-square test to check, if there are correlations between the Location and the Collisions-Type Hypothesis: #H1: There is a correlation between Location and Collisions-Type #H0: There is no correlation between Location and Collisions-Type

kreuztabelle2 <- table(trafficBad$Location, trafficBad$Collision_Type)
c2 <- chisq.test(kreuztabelle2, simulate.p.value = T)
c2 #p-value < 5%; Therefore a correlation exists. 

    Pearson's Chi-squared test with simulated p-value (based on 2000 replicates)

data:  kreuztabelle2
X-squared = 6639.4, df = NA, p-value = 0.0004998

#We hae to check for "1-Car" because of the empty value.
trafficBad %>% 
  filter(Collision_Type == "1-Car") %>% 
  group_by(Location) %>% 
  summarise(count = n()) %>% 
  arrange(desc(count)) %>% 
  print(n = Inf) #Es sind 4 1-Car Collisionstype in "HINDS & SR45W"

`summarise()` ungrouping output (override with `.groups` argument)

#fehlende Location Variable mit "HINDS & SR45W" ersetzen
trafficBad[trafficBad$Id == 1807877, ] <- trafficBad %>% 
                                              filter(Id == 1807877) %>% 
                                              mutate(Location = "HINDS & SR45W")

#Checking all columns to see if there is any empty value
sapply(trafficBad, function(x) sum(is.na(x))) #No Na

            Id           Year          Month            Day           Hour Collision_Type    Injury_Type Primary_Factor 
             0              0              0              0              0              0              0              0 
      Location       Latitude      Longitude 
             0              0              0 

#Mabe empty one like ""
trafficBad %>% 
  filter(Month == "")

trafficBad %>% 
  filter(Day == "")

trafficBad %>% 
  filter(Hour == "")

trafficBad %>% 
  filter(Collision_Type == "")

trafficBad %>% 
  filter(Injury_Type == "")

trafficBad %>% 
  filter(Primary_Factor == "") #Here are 4 empty values

trafficBad %>% 
  filter(Location == "")

trafficBad %>% 
  filter(Latitude == "")

trafficBad %>% 
  filter(Longitude == "")

#Primary_Factor has 4 empty Values. Lets fill them up
#How much Primary_Factors are there?
trafficBad %>% 
  group_by(Primary_Factor) %>% 
  summarise(count = n()) %>% 
  print(n = Inf)

`summarise()` ungrouping output (override with `.groups` argument)

#Grouping Primary_Factor and Location together and filtering the Locations that are in the empty rows
trafficBad %>% 
  group_by(Primary_Factor,Location) %>% 
  summarise(count = n()) %>% 
  filter(Location == "E MORNINGSIDE & N SMITH" | Location == "ORCHARD & SR37" | 
           Location == "HINES RD & SR45" | Location == "WALNUT ST")

`summarise()` regrouping output by 'Primary_Factor' (override with `.groups` argument)

#Unfortunatly they are the  only Locations with such a Primary_Factor
trafficBad %>% 
  group_by(Primary_Factor, Injury_Type) %>% 
  summarise(count = n()) %>% 
  filter(Injury_Type == "Incapacitating") %>% 
  arrange(desc(count)) %>% 
  print(n = Inf) #The most exisiting Primary_Factor with an "Incapacitating" Injura-type is "FAILURE TO YIELD RIGHT OF WAY". I will use this to fill the roows up

`summarise()` regrouping output by 'Primary_Factor' (override with `.groups` argument)

#filling
trafficBad[trafficBad$Primary_Factor == "",] <- trafficBad %>% 
  filter(Primary_Factor == "") %>% 
  mutate(Primary_Factor = "FAILURE TO YIELD RIGHT OF WAY")

After a second Data Manipulating step, we can finally foyus o answering questions.

Question on that we can answer with the data are for example: #Which Location is the most dangerous one? #Which Primary_Factor is the most tragic one compared to the Injury_type? #Which Collasion type is the most common? At which Time? On which Month? #What can the city Bloomington do, to reduce there traffic the most dangerous traffic-crashs? #Which time-period is given?

#Which Location is the most dangerous one in case of numbers and injury_type?
trafficBad %>% 
  group_by(Location)  %>% 
  summarise(number = n()) %>% 
  filter(number > 3) #"SMITHVILLE & SR37S" hat 8 Unfälle registriert 

`summarise()` ungrouping output (override with `.groups` argument)

trafficBad %>% 
  filter(Location == "SMITHVILLE & SR37S" ) #All of them are Incapacitating 

#Visualisierung 
most_dangerous0 <- trafficBad %>% 
  count(Location) %>% 
  filter(n > 3) %>% 
  pull(Location)

mostdangerous <- trafficBad %>% 
  filter(Location %in% most_dangerous0)

ggplot(mostdangerous, aes(Location)) +
  geom_bar(aes(fill = Location)) +
  theme_dark() +
  theme(axis.text.x = element_text(angle = 25, vjust = 1, hjust =1)) +
  ylim(0,8) +
  theme(legend.position = "none")

#Conclusion: Maybe there should be more Safety measures in ares like "SMITHVILLE & SR446S"; "FULLERTON & SR37S"; HINDS & SR45W; "SR37N & VERNAL

#Which Primary_Factor is the most tragic one compared to the Injury_type?

worst_Primary_Factor <- trafficBad %>% 
                            select(Primary_Factor, Injury_Type) %>% 
                            filter(Injury_Type == "Incapacitating") %>% 
                            group_by(Primary_Factor) %>% 
                            summarise(number_of_Primary_Factor_Cases =n()) %>% 
                            arrange(desc(number_of_Primary_Factor_Cases)) %>% 
                            filter(number_of_Primary_Factor_Cases > 100) #As "incapacitating is the worst injury type, we have to flter the data set 

`summarise()` ungrouping output (override with `.groups` argument)

#Visualisierung
worst_Primary_Factor_vis <- trafficBad %>% 
  select(Primary_Factor, Injury_Type) %>% 
  filter(Injury_Type == "Incapacitating") %>% 
  group_by(Primary_Factor) %>% 
  summarise(number_of_Primary_Factor_Cases =n()) %>% 
  arrange(desc(number_of_Primary_Factor_Cases)) %>% 
  filter(number_of_Primary_Factor_Cases > 100) %>% 
  pull(Primary_Factor)

`summarise()` ungrouping output (override with `.groups` argument)

worst_Primary_Factor_vis <- trafficBad %>% 
  filter(Primary_Factor %in% worst_Primary_Factor_vis)

ggplot(worst_Primary_Factor_vis, aes(Primary_Factor)) +
  geom_bar(fill = "salmon") +
  theme_dark()

#Which Collasion type is the most common? At which Time?

trafficBad %>% 
  group_by(Collision_Type) %>% 
  count()  #2-Car Collision are the most common (with 482 total cases)

#Vis 
coll2 <- trafficBad %>% 
  group_by(Collision_Type) %>% 
  count() %>%  
  pull(Collision_Type)

visdata <- trafficBad %>% 
  filter(Collision_Type %in% coll2)
ggplot(visdata, aes(Collision_Type, fill = Collision_Type)) +
  geom_bar() +
  theme_dark() +
  ggtitle("Most common Collision-Type")

trafficBad %>% 
  group_by(Hour) %>% 
  count %>% 
  filter(n > 20) %>% 
  arrange(desc(n)) #Most commonly accidents happen on 18 Hour (first place) and 15 + 17 Hour (second Place)

#Vis
ggplot(trafficBad, aes(as.factor(Hour))) +
  geom_bar() 

#Changing "1700" to "17"
trafficBad[trafficBad$Hour == 1700,"Hour"] <- 17
#Vis again
ggplot(trafficBad, aes(as.factor(Hour))) +
  geom_bar(fill = "orange") +
  theme_dark() +
  labs(x = "Hour") +
  ggtitle("Frequency distribution of accidents by time")

#Month
trafficBad %>% 
  group_by(Month) %>% 
  count %>% 
  filter(n > 20) %>% 
  arrange(desc(n))

#Vis
ggplot(trafficBad, aes(Month, fill = Month)) +
  geom_bar() +
  theme_dark() +
  ggtitle("Most common month of accidents")

#Year
trafficBad %>% 
  group_by(Year) %>% 
  count %>% 
  filter(n > 20) %>% 
  arrange(desc(n))

#Vis
ggplot(trafficBad, aes(Year, fill = Year)) +
  geom_bar() +
  theme_dark() +
  ggtitle("Most common Year of terrible accidents") #Its like an exponentiell graph. Future looks awefull if it is continueinh like this. Maybe Bloomington got more and more cars/people and has to improve there infrastructure

#Time priod 2003-2015

Now: What can the city Bloomington do, to reduce the most dangerous traffic-crashs? # Most of the accidents happened in October (due to lack of summer tires). Most very bad accidents happen between 3pm and 6pm # In 2015 the accident rate of “very bad car accidents” increased extremely (although, as stated at the beginning, the overall accident frequencies have not decreased). There may have been major problems with the infrastructure. # Most accidents are 2-car types. So there seems to be accidents due to a lack of infrastructure. #Recommendations: Reduce the pace. Expand the trams. Regulate intersections and roundabouts. # ‘Failure to yield right of way’ is the most common cause. It was not granted right before left. # Especially at intersections, additional signs should be added or violations of the rules on the right before left should be punished more # ’SMITHVILE & SR 37S has the most accidents. This place seems particularly dangerous. There may be crossings there that are not easy to spot. # Fortunately, most accidents are no injury and non incapacitating